unit DriveTools;

interface

uses
   Classes;

// funciones con Subst
function AddSubst(drive: char; const path: string; replace: boolean= false): boolean;
function EraseSubst(drive: char):boolean;
function GetSubsts(const drvs: string; var ListSubsts:TStringList): boolean;
function GetAllSubsts(var ListSubsts: TStringList): boolean;
function GetSubstPath(drive: char):string;
function IsSubstDrive(drive: char):boolean;
function EraseDrive(drive: char) : boolean;
function DrivesAssigned: string;
function DrivesAssignables: string;
function DrivesToAssign: string;

implementation

{$R sub.res}

uses
  Windows, SysUtils, Forms, Executer, Systools, AppTools, StrTools, FileTools;

var
  filesubstit, filetempsubst :string;

function GetSubstPath(drive:char):string;
  var ls:TStringlist;
begin
  ls:=TStringlist.Create;
  case DiskType(drive) of
    DRIVE_FIXED : begin
                    GetSubsts(drive,ls);
                    result := ls.Values[drive];
                  end;
  else
    result := '';
  end;
  ls.free;
end;

function IsSubstDrive(drive:char):boolean;
  var ls:TStringlist;
begin
  result := DiskType(drive)=DRIVE_FIXED;
  if not result then exit;
  result := pos(drive,Drives)<>0;
  if not result then exit;
  ls:=TStringlist.Create;
  GetSubsts(drive,ls);
  result := ls.Values[drive]<>'';
  ls.free;
end;

function GrabarRecurso(const Nombre,path:string) : boolean;
  var t:TResourceStream;
begin
  try
    t:=TResourceStream.Create(HInstance,Nombre,RT_RCDATA);
    t.SaveToFile(path);
    result := true;
  except
    result := false;
  end;
  t.Free;
end;

function EjecutarSubst(const Prms:string):boolean;
  var Exec :TExecuter; p:string;
begin
  p := ChangeFileExt(filesubstit,'.PIF');
  result := (FileExists(filesubstit) or GrabarRecurso('SUBSTIT',filesubstit)) and
            (FileExists(p) or GrabarRecurso('PIF',p));
  if not result then exit;
  try
    Exec :=TExecuter.Create(Application);
    with Exec do
    begin
      ExeName := ExtractFileName(filesubstit);
      PathExe := ExtractFilePath(filesubstit);
      Params := Prms;
      ProcessMessages := true;
      Show := Minimizado;
      Wait := Siempre;
      Start;
    end;
    result := true;
  except
    result := false;
  end;
  Exec.Free;
end;

function Win9XGetSubsts(const drvs:string; var ListSubsts:TStringList):boolean;
begin
  result := true;
  ListSubsts.clear;
  if drvs='' then exit;
  result := EjecutarSubst('/G FILE='+filetempsubst+' DRIVE='+Uppercase(drvs));
  if not result then exit;
  DeleteFile(filetempsubst);
  try
    ListSubsts.LoadFromFile(filetempsubst);
  except
  end;
  DeleteFile(filetempsubst);
end;

function SacarPrefijoNT( const fn:string):string;
var i:Integer;
begin
  i:=1;
  while (i<=length(fn)) and not (fn[i] in ['a'..'z','A'..'Z']) do Inc(i);
  result := Copy(fn,i,length(fn));
end;

function NTGetSubsts(const drvs: string; var ListSubsts: TStringList):boolean;
  var i : Integer;  p1:string; p2 : array[0..255] of char;
begin
  try
    for i := 1 to length(drvs) do
    begin
      p1 := drvs[i]+':';
      fillchar(p2,sizeof(p2),#0);
      if QueryDosDevice(pchar(p1),p2,sizeof(p2))<>0 then
      begin
        p1 := trim(SacarPrefijoNT(strpas(p2)));
        if pos('Device',p1)<>1 then ListSubsts.Add(drvs[i]+'='+p1);
      end;
    end;
    result := true;
  except
    result := false;
  end;
end;

function GetAllSubsts(var ListSubsts:TStringList) : boolean;
 var s:string; i:char;
begin
  s:='';
  for i:='C' to 'Z' do
    if DiskType(i)=DRIVE_FIXED then  s := s + i;
  result := GetSubsts(s,ListSubsts);
end;

function GetSubsts(const drvs:string; var ListSubsts:TStringList) : boolean;
begin
  if drvs='' then exit;
  if Win32Platform=VER_PLATFORM_WIN32_NT then
    result := NTGetSubsts(drvs,ListSubsts)
  else
    result := Win9XGetSubsts(drvs,ListSubsts);
end;

function Win9XEraseSubst(drive: char):boolean;
begin
  result := EjecutarSubst('/D'+' DRIVE='+Upcase(drive)+' SHOW=NO');
end;

function NTEraseSubst(drive: char):boolean;
  var s:string;
begin
  s := drive+':';
  result := DefineDosDevice(DDD_REMOVE_DEFINITION,pchar(s),nil);
end;

function EraseSubst(drive: char):boolean;
begin
  if Win32Platform=VER_PLATFORM_WIN32_NT then
    result := NTEraseSubst(drive)
  else
    result := Win9XEraseSubst(drive);
end;

function NTAddSubst(drive: char; const path: string; replace: boolean): boolean;
  var p1,p2:string;
begin
  if replace then NTEraseSubst(drive);
  p1 := drive+':';
  p2 := UnNormalizePAth(trim(path));
  result := DefineDosDevice(0,pchar(p1),pchar(p2));
end;

function Win9XAddSubst(drive: char; const path: string; replace:boolean=false):boolean;
  var p:string;
begin
  p:=trim(path);
  if (p<>'') and (p[length(p)]='\') and (length(p)>3) then
    SetLength(p,length(p)-1);
  drive := Upcase(drive);
  result := EjecutarSubst(StrIf(replace,'/R','/S')+' DRIVE='+drive+' PATH='+p);
end;

function AddSubst(drive: char; const path: string; replace:boolean=false):boolean;
  var  l:TStringList; p:string;
begin
  if Win32Platform=VER_PLATFORM_WIN32_NT then
    result := NTAddSubst(drive,path,replace)
  else
    result := Win9XAddSubst(drive,path,replace);
end;

function EraseDrive(drive: char) : boolean;
begin
  case DiskType(drive) of
    DRIVE_REMOTE : result := EraseConnection(drive)=NO_ERROR;
    DRIVE_FIXED  : result := EraseSubst(drive);
  else
    result := false;
  end;
end;

function DrivesAssigned:string;
  var i:integer; d:string;
begin
  result := ''; d:=Drives;
  for i := 1 to length(d) do
    if (DiskType(d[i])=DRIVE_REMOTE) or IsSubstDrive(d[i]) then
      result := result + d[i];
end;

function DrivesAssignables: string;
  var i:char; d:string;
begin
  result := ''; d:=Drives;
  for i := 'C' to 'Z' do
    if (pos(i,d)=0) or (DiskType(i)=DRIVE_REMOTE) or IsSubstDrive(i) then
      result := result + i;
end;

function DrivesToAssign: string;
  var i:char; d:string;
begin
  result := ''; d:=Drives;
  for i := 'C' to 'Z' do
    if pos(i,d)=0 then result := result + i;
end;

initialization
  filesubstit := NormalizePath(GetWindowsdir) + 'Substit.exe';
  filetempsubst := NormalizePath(GetWindowsdir) + '_subst.txt';
end.
